-- Copyright 2012, Google Inc.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--
--     * Redistributions of source code must retain the above copyright notice,
--       this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * Neither the name of Google Inc. nor the names of its contributors may
--       be used to endorse or promote products derived from this software
--       without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
-- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-- POSSIBILITY OF SUCH DAMAGE.

-- Author: Paul Brauner (polux@google.com)

module Text.Templating.Go.Parser (
  parseTemplate
) where

import Data.Char
import Data.Monoid
import Text.Parse
import Text.ParserCombinators.Poly.Plain

import Text.Templating.Go.Data

-- lexer part

reservedNames = 
  ["define", "true", "false", "if", "else",
   "range", "template", "with", "end" ]

char c = satisfy (== c)
string s = mapM char s

alpha = satisfy isAlpha
alphanum = satisfy isAlphaNum
space =  satisfy isSpace
spaces = many space

underscore = char '_'
comma = char ','

lexeme p = p <* spaces

stringLiteral :: TextParser String
stringLiteral = parse

charLiteral :: TextParser Char
charLiteral = parse


ident = do
  i <- ident'
  if i `elem` reservedNames
    then fail (i ++ " is a reserved word")
    else return i
  where ident' = idStart ~: many idLetter
        idStart = underscore </> alpha
        idLetter = underscore </> alphanum

reserved s = lexeme (string s)
reservedOp s = lexeme (string s)

-- combinators

-- UHC definition of <$ is screwed up, so we define <$$
x <$$ f = f *> return x

infixr 3 </>
p1 </> p2 = p1 `onFail` p2  

lookAhead (P p) = P $ \input ->
  case p input of
    Success _ res -> Success input (Just res)
    _             -> Success input Nothing

p ~: ps = (:) <$> p <*> ps

manyUntil p t = do
  test <- lookAhead t
  case test of
    Just _  -> return []
    Nothing -> p ~: manyUntil p t

many1Until p t = do
  test <- lookAhead t
  case test of
    Just _ -> fail "many1Until fail"
    Nothing -> p ~: manyUntil p t

option a p = p </> return a

-- The parser

top :: TextParser Template
top = Concat <$> many template

template :: TextParser Template
template = comment
       </> ifAction
       </> rangeAction
       </> withAction
       </> defineAction
       </> templateAction
       </> pipelineAction
       </> Text <$> text

pipeline :: TextParser Pipeline
pipeline = Pipeline <$>
  (command `sepBy` reservedOp "|")

command :: TextParser Expr
command = assign </> apply </> expr
  where assign = do
          lhs <- lhsVar `sepBy1` lexeme comma
          reservedOp ":="
          p <- pipeline
          return $ VarDef lhs p
        apply = do
          e1 <- expr
          spaces
          e2 <- expr
          es <- expr `sepBy` spaces
          return $ Apply e1 (e2:es)
        lhsVar = lexeme $ do
          char '$'
          i <- ident
          return (Dollar i)

expr :: TextParser Expr
expr = lexeme expr'
  where expr' = (Bool <$> (reserved "true" *> return True))
            </> (Bool <$> (reserved "false" *> return False))
            </> (Integer <$> parseSigned parseDec)
            </> (Double <$> parseSigned parseFloat)
            </> (Char <$> charLiteral)
            </> (String <$> stringLiteral)
            </> access

access :: TextParser Expr
access = dollarchain  -- $x.a.b.c
     </> chain        -- .a.b.c
     </> singledollar -- $
     </> singledot    -- .
     </> fun          -- f
  where dollarchain = do
          char '$'
          x <- ident
          xs <- accesses
          return $ AccessChain (Dollar x) xs
        chain = do
          char '.'
          x <- ident
          xs <- accesses
          return $ AccessChain Dot (x:xs)
        singledollar = AccessChain (Dollar "") [] <$$ char '$'
        singledot = AccessChain Dot [] <$$ char '.'
        fun = flip AccessChain [] . Plain <$> ident
        accesses = many (char '.' *> ident)

comment :: TextParser Template
comment = do
  string "{{/*"
  manyUntil next end
  end
  return mempty
  where end = string "*/}}"

braces keyword p = do
  string "{{"
  spaces
  reserved keyword
  res <- p
  string "}}"
  return res

braces' keyword = braces keyword spaces

ifAction :: TextParser Template
ifAction = do
  p <- braces "if" pipeline
  t1 <- top
  t0 <- option mempty (braces' "else" *> top)
  braces' "end"
  return $ If p t1 t0

rangeAction :: TextParser Template
rangeAction = do
  p <- braces "range" pipeline
  t1 <- top
  t0 <- option mempty (braces' "else" *> top)
  braces' "end"
  return $ Range p t1 t0

defineAction :: TextParser Template
defineAction = do
  x <- braces "define" stringLiteral
  t <- top
  braces' "end"
  return $ Definition ("__t_" ++ x) t

templateAction :: TextParser Template
templateAction = braces "template" $
  TemplateCall <$> (("__t_" ++) <$> stringLiteral)
               <*  spaces
               <*> (option (Pipeline []) pipeline)

withAction :: TextParser Template
withAction = do
  p <- braces "with" pipeline
  t1 <- top
  t0 <- option mempty (braces' "else" *> top)
  braces' "end"
  return $ With p t1 t0

pipelineAction :: TextParser Template
pipelineAction = do
  string "{{"
  spaces
  p <- pipeline
  string "}}"
  return $ Expression p

text = many1Until next textEnd
  where textEnd = (() <$$ string "{{") </> eof

-- Public

parseTemplate :: String -> Either String Template
parseTemplate s = fst (runParser (top <* eof) s)
